1 POKE53280,0:POKE53281,0:PRINTCHR$(8):POKE53272,20
2 PRINT"[147]HUMPTY SOFTWARE CHARACTER SET COMPRESSOR"
3 PRINT"(C) AND WRITTEN HUMPTY DAMIEN MARSH 1988"
4 PRINT"FOR USE BY HUMPTY SOFTWARE PERSONAL ONLY"
5 PRINT"CHAR.SET SHOULD ALREADY HAVE BEEN LOADED"
6 PRINT"WHAT MEMORY POSITION DOES THE SET BEGIN?"
7 GOSUB50:IFA<6000ORA>53000OR(A>40000ANDA<49000)ORA/2048<>INT(A/2048)THEN7
8 S=A:PRINT"LAST CHAR.IN SET IS CHAR.NO. (INCLUSIVE)"
9 GOSUB50:IFA<2ORA>255THEN9
10 L=A:PRINT"SCANNING SET FOR DUPLICATES. PLEASE WAIT"
11 DIMC(L),D(L),E(L):C(0)=256:E=0:FORI=1TOL:FORJ=0TOI-1:F=0
12 FORK=0TO7:IFPEEK(S+I*8+K)<>PEEK(S+J*8+K)THENF=1
13 NEXT:ONFGOTO14:C(I)=J:J=I:GOTO15
14 C(I)=256:E=1
15 NEXT:NEXT:IFE=0THENPRINT"SORRY, THERE'S NO DUPLICATES IN CHAR.SET":GOTO49
16 PRINT"SCAN COMPLETE. TABLE OF DUPLICATES READY"
17 PRINT"PRINT TABLE OF DUPLICATES ON THE SCREEN?"
18 GOSUB51:ON1-(A$="N")-(2*(A$="Y"))GOTO18,19:F=1:GOSUB52
19 PRINT"LIST TABLE OF DUPLICATES TO THE PRINTER?"
20 PRINT"IF 'Y' THEN ENSURE THAT PRINTER IS READY"
21 GOSUB51:ON1-(A$="N")-(2*(A$="Y"))GOTO21,23:F=0:OPEN1,4:CMD1:GOSUB52
22 PRINTCHR$(13)
23 CLOSE1:OPEN3,3:CMD3:PRINT"OPTIONS: (Q)UIT NOW,(D)ELETE DUPLICATES,"
24 PRINT"[145](C)OMPRESS CHARSET. PRESS (Q),(D) OR (C)"
25 GOSUB51:ON((A$="Q")*-1)+((A$="D")*-2)+((A$="C")*-3)+1GOTO25,49,26,34
26 PRINT"NUMBER TO FILL DELETED CHARACTERS WITH ?"
27 GOSUB50:IFA<0ORA>255THEN28
28 PRINT"FILLING DUPLICATES WITH THE ABOVE NUMBER"
29 F=A:FORI=0TOL:IFC(I)<256THENFORJ=0TO7:POKES+I*8+J,F:NEXT
30 NEXT:PRINT"COMPLETE. DUPLICATES ARE NOW ALL DELETED"
31 FORI=0TOL:IFC(I)<256THEND(I)=C(I):GOTO33
32 D(I)=I
33 NEXT:GOTO43
34 PRINT"REMOVING DUPLICATES AND COMPRESSING SET.":Z=0:D(0)=0
35 Z=Z+1:D(Z)=Z:IFC(Z)=256THEN35
36 J=Z:FORI=ZTOL:FORK=0TO7:POKE14336+J*8+K,PEEK(14336+I*8+K):NEXT
37 IFC(I)=256THEND(I)=J:J=J+1:GOTO39
38 D(I)=D(C(I))
39 NEXT:L1=J-1:PRINT"COMPLETE.  NUMBER TO FILL EXCESS CHARS ?"
40 GOSUB50:IFA<0ORA>255THEN40
41 Z=A:FORI=S+L1*8TOS+2047:POKEI,Z:NEXT
42 PRINT"COMPLETE. THERE ARE NOW"L1"CHARS USED."
43 PRINT"LIST OLD CHARS/NEW CHARS TABLE TO SCREEN"
44 GOSUB51:ON1-(A$="N")-(2*(A$="Y"))GOTO44,45:F=1:GOSUB60
45 PRINT"LIST OLD CHAR/NEW CHAR TABLE TO PRINTER?"
46 GOSUB51:ON1-(A$="N")-(2*(A$="Y"))GOTO46,48:F=0:OPEN1,4:CMD1:GOSUB60
47 PRINTCHR$(13):CLOSE1:CLOSE3:OPEN3,3:CMD3
48 PRINT"I SUGGEST THAT YOU SAVE YOUR NEW SET NOW"
49 PRINT"[145][155]":END
50 GOSUB51:A=VAL(A$)-((A$="0")/10):ON-(A=0)GOTO50:A=INT(A):RETURN
51 POKE19,2:PRINT"[145]>";:INPUTA$:POKE19,0:PRINT:RETURN
52 PRINT:GOSUB58
53 FORI=0TOL:PRINTITAB(20):IFC(I)=256THENPRINT"*****":GOTO55
54 PRINTC(I)
55 IFPEEK(214)=24ANDF=1THENWAIT198,1:POKE198,0:GOSUB58
56 NEXT:IFF=1ANDPEEK(214)>17THENWAIT198,1:POKE198,0
57 RETURN
58 IFFTHENPRINT"[147]";
59 PRINT"CHARACTER NUMBER"SPC(4)"IS IDENTICAL TO":PRINT:RETURN
60 PRINT:GOSUB65
61 FORI=0TOL:PRINTITAB(20)D(I)
62 IFPEEK(214)=24ANDF=1THENWAIT198,1:POKE198,0:GOSUB65
63 NEXT:IFF=1ANDPEEK(214)>19THENWAIT198,1:POKE198,0
64 RETURN
65 IFFTHENPRINT"[147]";
66 PRINT"OLD CHARSET"SPC(9)"NEW CHARSET":PRINT:RETURN